R functions
# install.packages("plyr")
library(plyr)
#> Warning: package 'plyr' was built under R version 4.2.1
# devtools::install_github("pavlakrotka/NCC@v1.0")
library(NCC)
#> Registered S3 methods overwritten by 'registry':
#> method from
#> print.registry_field proxy
#> print.registry_entry proxy
#> Warning: package 'memoise' was built under R version 4.2.1
source("C:/Users/mbofi/Dropbox/CeMSIIS/GitHub/Allocation/case-study/aux_functions.R")
We illustrate the optimal allocations in platform trials by means of a phase II placebo-controlled trial in primary hypercholesterolemia.
In the original study, \(N=92\) patients were randomised following 1:1:1. The estimated means were
# means
mean_control = 17.3/3.5
mean_arm1 = 66.2/3.5
mean_arm2 = 72.3/3.5
In what follows, we simulated the trial using the estimated means in the original study using three allocation strategies -namely, equal allocation (1:…:1), square root of \(k\) (1:…:\(\sqrt(k)\)), and the proposed optimal allocations-, and according to three different trial designs:
In this case, we consider a design with one period only. The scheme of the trial over time is:
db1_one = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db1_sqrt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db1_opt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db1_one$data$treatment)
Figure: Design 1: multi-arm design.
Distribution of sample sizes per arm and periods
# sample sizes
db1_one$ss
#> [,1] [,2] [,3]
#> [1,] 31 0 0
#> [2,] 31 0 0
#> [3,] 31 0 0
db1_sqrt$ss
#> [,1] [,2] [,3]
#> [1,] 27 0 0
#> [2,] 27 0 0
#> [3,] 38 0 0
db1_opt$ss
#> [,1] [,2] [,3]
#> [1,] 27 0 0
#> [2,] 27 0 0
#> [3,] 38 0 0
db1_one_ss <- data.frame(arms=c("A1","A2","C"),db1_one$ss, c(sum(db1_one$ss[1,]),sum(db1_one$ss[2,]),sum(db1_one$ss[3,])))
db1_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db1_sqrt$ss, c(sum(db1_sqrt$ss[1,]),sum(db1_sqrt$ss[2,]),sum(db1_sqrt$ss[3,])))
db1_opt_ss <- data.frame(arms=c("A1","A2","C"), db1_opt$ss, c(sum(db1_opt$ss[1,]),sum(db1_opt$ss[2,]),sum(db1_opt$ss[3,])))
The sample sizes per arm and period according to the allocation strategies are the following:
knitr::kable(db1_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 31 | 0 | 0 | 31 |
| A2 | 31 | 0 | 0 | 31 |
| C | 31 | 0 | 0 | 31 |
knitr::kable(db1_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 27 | 0 | 0 | 27 |
| A2 | 27 | 0 | 0 | 27 |
| C | 38 | 0 | 0 | 38 |
knitr::kable(db1_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 27 | 0 | 0 | 27 |
| A2 | 27 | 0 | 0 | 27 |
| C | 38 | 0 | 0 | 38 |
Comparing groups when using 1:1 allocation
res1_one = do.call(rbind.data.frame, models_cc(data = db1_one$data) )
knitr::kable(res1_one, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 11.59802 | 8.979796 | 14.21624 | TRUE | a1 |
| 0 | 16.55461 | 13.792100 | 19.31711 | TRUE | a2 |
Comparing groups when using \(\sqrt(k)\)-allocation (and thus optimal allocations)
res1_opt = do.call(rbind.data.frame, models_cc(data = db1_opt$data) )
knitr::kable(res1_opt, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 11.14104 | 8.497606 | 13.78448 | TRUE | a1 |
| 0 | 15.23597 | 12.511468 | 17.96047 | TRUE | a2 |
In this case, we consider a design with two periods. The scheme of the trial over time is:
db2_one=sim_designs(r1=n_arm1/N,r2=1-n_arm1/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db2_sqrt=sim_designs(r1=n_arm1/N,r2=1-n_arm1/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db2_opt=sim_designs(r1=n_arm1/N,r2=1-n_arm1/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db2_one$data$treatment)
Figure: Design 2: two-period design.
# sample sizes
db2_one$ss
#> [,1] [,2] [,3]
#> [1,] 0 20 0
#> [2,] 16 20 0
#> [3,] 16 20 0
db2_sqrt$ss
#> [,1] [,2] [,3]
#> [1,] 0 18 0
#> [2,] 16 18 0
#> [3,] 16 25 0
db2_opt$ss
#> [,1] [,2] [,3]
#> [1,] 0 26 0
#> [2,] 16 7 0
#> [3,] 16 27 0
db2_one_ss <- data.frame(arms=c("A1","A2","C"),db2_one$ss, c(sum(db2_one$ss[1,]),sum(db2_one$ss[2,]),sum(db2_one$ss[3,])))
db2_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db2_sqrt$ss, c(sum(db2_sqrt$ss[1,]),sum(db2_sqrt$ss[2,]),sum(db2_sqrt$ss[3,])))
db2_opt_ss <- data.frame(arms=c("A1","A2","C"), db2_opt$ss, c(sum(db2_opt$ss[1,]),sum(db2_opt$ss[2,]),sum(db2_opt$ss[3,])))
The sample sizes per arm and period according to the allocation strategies are the following:
knitr::kable(db2_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 0 | 20 | 0 | 20 |
| A2 | 16 | 20 | 0 | 36 |
| C | 16 | 20 | 0 | 36 |
knitr::kable(db2_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 0 | 18 | 0 | 18 |
| A2 | 16 | 18 | 0 | 34 |
| C | 16 | 25 | 0 | 41 |
knitr::kable(db2_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 0 | 26 | 0 | 26 |
| A2 | 16 | 7 | 0 | 23 |
| C | 16 | 27 | 0 | 43 |
Comparing groups when using 1:1 allocation
res2_one = do.call(rbind.data.frame, models_cc(data = db2_one$data) )
knitr::kable(res2_one, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 14.25713 | 12.74585 | 15.76841 | TRUE | a1 |
| 0 | 15.48262 | 12.94358 | 18.02167 | TRUE | a2 |
Comparing groups when using \(\sqrt(k)\)-allocation
res2_sqrt = do.call(rbind.data.frame, models_cc(data = db2_sqrt$data) )
knitr::kable(res2_sqrt, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 14.44525 | 13.13724 | 15.75326 | TRUE | a1 |
| 0 | 16.65059 | 14.25944 | 19.04175 | TRUE | a2 |
Comparing groups when using the optimal allocations
res2_opt = do.call(rbind.data.frame, models_cc(data = db2_opt$data) )
knitr::kable(res2_opt, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 14.75035 | 13.15520 | 16.34551 | TRUE | a1 |
| 0 | 17.17213 | 15.12269 | 19.22158 | TRUE | a2 |
Suppose now a design with three periods with \(N_1=31\) and consider two situations for \(N_2\), say \(N_2=N-N_1\) and \(N_2= N_1/2\).
Below we illustrate the scheme of the trial over time. Note that in this case the duration of periods 1 and 3 is the same, leading to a symmetrical trial.
N1 = round(N/3)
N2 = round(2*(N-N1)/3)
db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db3_opt$data$treatment)
Design 3: three-period design (r1=r3).
# sample sizes
db3_one$ss
#> [,1] [,2] [,3]
#> [1,] 0 14 10
#> [2,] 16 14 0
#> [3,] 16 14 10
db3_sqrt$ss
#> [,1] [,2] [,3]
#> [1,] 0 12 10
#> [2,] 16 12 0
#> [3,] 16 17 10
db3_opt$ss
#> [,1] [,2] [,3]
#> [1,] 0 16 10
#> [2,] 16 8 0
#> [3,] 16 17 10
db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))
The sample sizes per arm and period according to the allocation strategies are the following:
knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 0 | 14 | 10 | 24 |
| A2 | 16 | 14 | 0 | 30 |
| C | 16 | 14 | 10 | 40 |
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 0 | 12 | 10 | 22 |
| A2 | 16 | 12 | 0 | 28 |
| C | 16 | 17 | 10 | 43 |
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 0 | 16 | 10 | 26 |
| A2 | 16 | 8 | 0 | 24 |
| C | 16 | 17 | 10 | 43 |
Comparing groups when using 1:1 allocation
res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
knitr::kable(res3_one, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 14.23093 | 12.96710 | 15.49475 | TRUE | a1 |
| 0 | 15.10714 | 13.84016 | 16.37411 | TRUE | a2 |
Comparing groups when using \(\sqrt(k)\)-allocation
res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
knitr::kable(res3_sqrt, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 11.56316 | 10.43177 | 12.69456 | TRUE | a1 |
| 0 | 14.07790 | 12.97099 | 15.18480 | TRUE | a2 |
Comparing groups when using the optimal allocations
res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
knitr::kable(res3_opt, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 14.46261 | 13.07080 | 15.85443 | TRUE | a1 |
| 0 | 16.05739 | 14.82917 | 17.28562 | TRUE | a2 |
N1 = round(N/3)
N2 = round(2*(N-N1)/3)
# c(N1,N2,N-N1-N2)
db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db3_opt$data$treatment)
Design 3: three-period design (r1<r3).
# sample sizes
db3_one$ss
#> [,1] [,2] [,3]
#> [1,] 0 14 10
#> [2,] 16 14 0
#> [3,] 16 14 10
db3_sqrt$ss
#> [,1] [,2] [,3]
#> [1,] 0 12 10
#> [2,] 16 12 0
#> [3,] 16 17 10
db3_opt$ss
#> [,1] [,2] [,3]
#> [1,] 0 16 10
#> [2,] 16 8 0
#> [3,] 16 17 10
db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))
The sample sizes per arm and period according to the allocation strategies are the following:
knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 0 | 14 | 10 | 24 |
| A2 | 16 | 14 | 0 | 30 |
| C | 16 | 14 | 10 | 40 |
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 0 | 12 | 10 | 22 |
| A2 | 16 | 12 | 0 | 28 |
| C | 16 | 17 | 10 | 43 |
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
| Arms | Period 1 | Period 2 | Period 3 | Total per arm |
|---|---|---|---|---|
| A1 | 0 | 16 | 10 | 26 |
| A2 | 16 | 8 | 0 | 24 |
| C | 16 | 17 | 10 | 43 |
Comparing groups when using 1:1 allocation
res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
knitr::kable(res3_one, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 13.30239 | 12.15155 | 14.45322 | TRUE | a1 |
| 0 | 16.58711 | 15.29116 | 17.88306 | TRUE | a2 |
Comparing groups when using \(\sqrt(k)\)-allocation
res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
knitr::kable(res3_sqrt, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 13.59608 | 12.32446 | 14.86769 | TRUE | a1 |
| 0 | 15.12641 | 13.66878 | 16.58404 | TRUE | a2 |
Comparing groups when using the optimal allocations
res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
knitr::kable(res3_opt, format = "markdown")
| p_val | treat_effect | lower_ci | upper_ci | reject_h0 | arm |
|---|---|---|---|---|---|
| 0 | 13.83088 | 12.55305 | 15.10870 | TRUE | a1 |
| 0 | 16.41824 | 15.08426 | 17.75223 | TRUE | a2 |
To compare power and type 1 error of the different designs, we undertake a simulation study to evaluate the performance when using 1:1 allocations. For comparative purposes, we also consider a total sample size for the trial equal to XX
Center for Medical Statistics, Informatics and Intelligent Systems, Medical University of Vienna.
[Klassifizierung: vertraulich]
marta.bofillroig@meduniwien.ac.at
and Martin Posch
martin.posch@meduniwien.ac.at